COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	(DEFPROP GRAPH (
C00005 ENDMK
C⊗;
(DEFPROP GRAPH (
 LOSE
 TER
 LOSING
 ISWIN
 WINNING
 PRUNE
 RESTART
)GRAPHFNS)

;;;auxiliary functions for searching a graph via SEARCH

(DEFUN LOSE (P) (MEMBER (CAR P) (CDR P)))

(DEFUN TER (P) (EQ (CAR P) FINAL))

(DEFPROP SUCCESSORS 
  (LAMBDA (P) (MAPCAR (FUNCTION (LAMBDA (X) (CONS X P)))
                      (CDR (ASSOC (CAR P) GRAPH))))
S1)


;;;auxiliary functions to do graph search with DEPTHFIRST, BSEARCH or BREADTHFIRST

(DEFUN LOSING (P) (GET P 'LOSER))

(DEFUN ISWIN(P) (EQ P FINAL))

(DEFPROP SUCCESSORS 
  (LAMBDA (P) 
  (COND ((GET P 'LOSER) NIL)
	((PUTPROP P T 'LOSER) (PRUNE (ASSOC P GRAPH))) ))
S2)

(DEFUN PRUNE (L)
  (COND ((NULL L) NIL)
	((GET (CAR L) 'LOSER) (PRUNE (CDR L)))
	(T (CONS (CAR L) (PRUNE (CDR L)))) ))

;;;(RESTART GRAPH 'S1 'F) gets you ready to run with S1 successors fn and goal of F
;;;(RESTART GRAPH 'S2 'F) gets you ready to run with S1 successors fn and gola of F
;;;restart is essential when successors S2 and/or BREADTHFIRST are being used as 
;;;	you need clean property lists to start

(DEFUN RESTART (G SFN GOAL) 
  (PROGN
      (MAPC '(LAMBDA (P) (REMPROP P 'DADDY)(REMPROP P 'LOSER)) (APPLY 'APPEND G)) 
      (PUTPROP 'SUCCESSORS (GET 'SUCCESSORS SFN) 'EXPR)
      (SETQ FINAL GOAL)
      'READY ))

;;;A sample graph

(SETQ GRAPH '((A B) (B A C D) (C B D E) (D B C E) (E C D F) (F E)))